perm filename CQ[NEW,LCS] blob
sn#701998 filedate 1983-02-18 generic text, type T, neo UTF8
1) CLEFS.F4[NEW,LCS] and 2) UDP:CLEFS.F4[NEW,LCS] 2-18-83 12:09 pages 1,1
**** File 1) CLEFS.F4[NEW,LCS]/1P/3L
1) C**** CLEFS, ROTSAV, GETLIB, MOVER, CLIP, IBOTH, CLP
1) SUBROUTINE CLEFS
1) C**** 2/14/83 THIS FORM SHOULD HOLD ALL TYPE FONTS AND 'CLEF' FILES IN CORE.
1) C**** NOW HOLDS 50 LIBE. FILES ALWAYS + 5 FOR USER.
1) C**** JCLEF(14000) =C.55*250 LIBNUM=55 NPT(LIBNUM+2) NAM(LIBNUM+1)
1) C**** JCLMAX =14000 JPMAX= 55*10 = 550 ++++ MAX VECTS IN SINGLE ITEM=500
1) C**** KPT(JPMAX+10)
1) C**** IF CHANGES, FIX DIMENSIONS AND DATA (LIBNUM)
1) DIMENSION JCLEF(14000),NAM(56),NPT(57),KPT(560),CM(4)
1) COMMON /LIBE/KNM,JCLMAX,JPMAX,LIBNUM,JPT,NM
1) COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/3L
2) C**** CLEFS, GETLIB, MOVER, CLIP, IBOTH, CLP
2) SUBROUTINE CLEFS
2) C**** 9/10/82 THIS FORM SHOULD HOLD ALL TYPE FONTS AND 'CLEF' FILES IN CORE.
2) C**** NOW HOLDS 49 LIBE. FILES AT ONCE. *******
2) C**** KPNT(539) =49*11 JCLEF(17150) =49*350 NAM(49) =49*1 LIBNUM=49
2) C**** KROT=16101 (350*(LIBNUM-3)+1) LROT=47 (LIBNUM-2)
2) C**** IF CHANGES, FIX DIMENSIONS AND DATA (LIBNUM,LROT,KROT)
2) DIMENSION KPNT(539),JCLEF(17150),NAM(49),RCMIN(4),CM(4)
2) 1,NPT(70),KPT(700)
2) COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS,XDIS/BM/F,G,H
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/18L
1) DATA LIBNUM/55/,JCLMAX/14000/,JPMAX/550/,NPT(1)/1/,KPT(1)/1/,
1) 1 RINC/4.0/,CM/.1,1.5,1.1,1.5/,XDIS/1.0/
1) EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7))
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/17L
2) DATA LIBNUM/70/,KROT/16101/,LROT/47/,RINC/4.0/,
2) 1JCLMAX/16000/,
2) 1 RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/,XDIS/1.0/,
2) 1JPMAX/690/,KX/0/,KJP/1/,NPT(1)/1/,KPT(1)/1/,JPT/1/
2) EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J9,JQ(7))
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/76L
1) 100 CALL GETLIB(JCLEF,NAM,NPT,KPT)
1) C GETS LIBRARY FILES. CHECKS FOR OVERFLOW. SHUFFLES IF NECESSARY.
1) 110 IF(J5.GT.3)GO TO 130
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/76L
2) 100 KNM=KX+1
2) NAM(KNM)=NM
2) C CALL GETLIB(JCLEF,KPNT,KX)
2) CALL GETLIB(JCLEF(KJP),KPT(JPT),NPT(KNM),JPT)
1) CLEFS.F4[NEW,LCS] and 2) UDP:CLEFS.F4[NEW,LCS] 2-18-83 12:09 pages 1,1
2) KX=KNM
2) 104 KJP=KPT(JPT)
2) C KJP=POINT TO START NEXT LIBE. FILE
2) CC IF(KX.EQ.LIBNUM)KX=KX-3
2) C 8/30/82 **** NOW RESERVES LAST 3 SLOTS FOR USER LIBE .DMD FILES ****
2) IF(KX.LT.LIBNUM.AND.KJP.LT.JCLMAX.AND.JPT.LT.JPMAX)GO TO 110
2) L=LIBNUM-10
2) LL=L+1
2) C ROTATE DATA IN LAST 10 AREAS
2) N=NPT(L)
2) NN=NPT(LL)
2) NNN=NN-N
2) KK=KPT(NN)-KPT(N)
2) C KK= NUM OF DATA ELEMENTS TO DELETE
2) DO 101 K=KPT(N),KPT(NPT(KX+1))
2) C SHIFT DATA
2) 101 JCLEF(K)=JCLEF(K+KK)
2) DO 103 K=N,NPT(KX+1)
2) C SHIFT POINTERS TO DATA
2) 103 KPT(K)=KPT(K+NNN)-KK
2) C NNN=NUM OF ITEMS IN DELETED LIBE.
2) DO 102 K=L,LIBNUM
2) C DO 102 K=L,LIBNUM-1
2) NPT(K)=NPT(K+1)-NNN
2) NNM=NAM(K+1)
2) IF(K.GT.KX)NNM=0
2) 102 NAM(K)=NNM
2) JPT=NPT(KX)
2) KX=KX-1
2) C ALL POINTERS RESET, GO BACK AND CHECK AGAIN.
2) GO TO 104
2) 110 IF(J5.GT.3)GO TO 130
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/101L
1) N=NPT(KNM)+JEZ-1
1) IF(N.LT.JPT)GO TO 150
1) C POINTER IS OUT OF DATA RANGE.
1) C JUMP IF THERE IS REALLY SOMETHING THERE.
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/134L
2) C L=KNM-1
2) C L=KPNT(L*11+JEZ)+L*350
2) N=NPT(KNM)+JEZ-1
2) L=KPT(N)
2) C NOW GET POINTER IN JCLEF ARRAY FOR THIS ITEM.
2) IF(L.GT.0)GO TO 150
2) C JUMP IF THERE IS REALLY SOMETHING THERE.
1) CLEFS.F4[NEW,LCS] and 2) UDP:CLEFS.F4[NEW,LCS] 2-18-83 12:09 pages 1,1
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/110L
1) 150 L=KPT(N)
1) C NOW L = POINTER IN JCLEF ARRAY FOR THIS ITEM.
1) IF(J9.EQ.0)GO TO 170
1) C***** ROTATE *******
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/146L
2) 150 IF(J9.EQ.0)GO TO 170
2) C***** ROTATE *******
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/118L
1) CALL ROTSAV(JCLEF(L),0)
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/152L
2) C KNT=KROT
2) C ROTATED DATA IS PUT STARTING AT LOCATION 701.(AREA FOR NM3)******
2) C JCLEF(KNT)=N
2) CALL ROTSAV(JCLEF(L),0)
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/135L
1) R6=1.
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/172L
2) C160 JCLEF(KNT)=M*10000+J+JJ*100000000
2) C L=KROT
2) C *********** SEE AT TOP **********
2) R6=1.
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/139L
1) C R9=P9=DEGREES OF ROTATION (0-360)
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/179L
2) C NAM(LROT)=0
2) C WIPES OUT DATA AREA FOR LAST NAME-2
2) C R9=P9=DEGREES OF ROTATION (0-360)
***************
**** File 1) CLEFS.F4[NEW,LCS]/1P/223L
1) SUBROUTINE GETLIB(JCLEF,NAM,NPT,KPT)
1) C GETS LIBRARY FILES. CHECKS FOR OVERFLOW. SHUFFLES IF NECESSARY.
1) DIMENSION JCLEF(1),NAM(1),NPT(1),KPT(1)
1) COMMON /ROT/KPNT(11)
1) CLEFS.F4[NEW,LCS] and 2) UDP:CLEFS.F4[NEW,LCS] 2-18-83 12:09 pages 1,1
1) CC COMMON /ALF/NM,KPNT(11),N,NN,NNN,KK,L,K,LL
1) COMMON /LIBE/KNM,JCLMAX,JPMAX,LIBNUM,JPT,NM
1) DATA KJP/1/,JPT/1/,KX/0/
1) 100 KNM=KX+1
1) NAM(KNM)=NM
1) CALL FASTI2(KPNT,11)
1) C GET LIBE FILE WD COUNTS
1) NJP=KJP
1) C NJP=START OF THIS INPUT OF JCLEF DATA
1) KJP=KJP+KPNT(11)
1) C POINT TO SPOT FOR INPUT TO JCLEF NEXT TIME AROUND
1) L=KPT(JPT)-1
1) C TOTAL ALREADY IN KPT LIST
1) DO 105 N=2,10
1) JPT=JPT+1
1) C UPDATE COUNTER
1) IF(KPNT(N).EQ.0)GO TO 106
1) C JUMP OUT IF FILE HAS LESS THAN 10 ITEMS
1) IF(KPNT(N).GT.KPNT(N-1))GO TO 105
1) KPNT(N)=KPNT(11)
1) C DRAW PROGRAM SOMETIMES DOESN'T GIVE WD COUNT OF LAST ITEM
1) GO TO 106
1) 105 KPT(JPT)=L+KPNT(N)
1) C UPDATE JCLEF POINTER LIST
1) JPT=JPT+1
1) N=11
1) 106 KPT(JPT)=KPNT(11)+L+1
1) C POINT TO NEXT FREE SPACE IN JCLEF
1) NPT(KNM+1)=NPT(KNM)+N-1
1) C UPDATE POINTER TO POINTER LIST
1) KX=KNM
1) C KJP=POINT TO START NEXT LIBE. FILE
1) C 2/14/83 **** NOW RESERVES LAST 5 SLOTS FOR USER LIBE .DMD FILES ****
1) 104 IF(KX.LE.LIBNUM.AND.KJP.LE.JCLMAX.AND.JPT.LE.JPMAX)GO TO 107
1) L=KX-6
1) C ROTATE DATA IN LAST 5 AREAS
1) N=NPT(L)
1) NN=NPT(L+1)
1) NNN=NN-N
1) C NNN=NUM OF ITEMS IN DELETED LIBE.
1) KK=KPT(NN)-KPT(N)
1) C KK= NUM OF DATA ELEMENTS TO DELETE
1) JPT=JPT-NNN
1) NJP=NJP-KK
1) C NJP POINTS TO START OF NEXT LIBE IN JCLEF.
1) KJP=KJP-KK
1) C KJP POINTS TO START NEXT TIME AROUND.
1) LL=KPT(NPT(KX+1))
1) CLEFS.F4[NEW,LCS] and 2) UDP:CLEFS.F4[NEW,LCS] 2-18-83 12:09 pages 1,1
1) IF(LL.GT.JCLMAX)LL=JCLMAX
1) DO 101 K=KPT(N),LL
1) CC DO 101 K=KPT(N),KPT(NPT(KX+1))
1) C SHIFT DATA
1) 101 JCLEF(K)=JCLEF(K+KK)
1) LL=NPT(KX+1)
1) IF(LL.GT.JPMAX)LL=JPMAX
1) DO 103 K=N,LL
1) CC DO 103 K=N,NPT(KX+1)
1) C SHIFT POINTERS TO DATA
1) 103 KPT(K)=KPT(K+NNN)-KK
1) DO 102 K=L,LIBNUM+1
1) NPT(K)=NPT(K+1)-NNN
1) NNM=NAM(K+1)
1) C SHIFT LIBE FILE NAMES
1) 102 NAM(K)=NNM
1) KX=KX-1
1) KNM=KNM-1
1) C ALL POINTERS RESET, GO BACK AND CHECK AGAIN.
1) GO TO 104
1) 107 CALL FASTI2(JCLEF(NJP),KPNT(11))
1) C GETS LIBRARY AND PUTS IT IN RIGHT SLOT
1) END
**** File 2) UDP:CLEFS.F4[NEW,LCS]/1P/265L
2) SUBROUTINE GETLIB(J,K,L,JPT)
2) C SUBROUTINE GETLIB(JCLEF,KPNT,KX)
2) C GETS LIBRARY AND PUTS IT IN RIGHT SLOT
2) C DIMENSION JCLEF(1),KPNT(1)
2) DIMENSION J(1),K(1),L(1),KPNT(11)
2) C N=KX*11+1
2) C POINTER TO DIRECTORY OF EACH FINE
2) C CALL FASTI2(KPNT(N),11)
2) CALL FASTI2(KPNT,11)
2) L(1)=JPT
2) C N=KPNT(N+10)
2) N=KPNT(11)-1
2) IF(N.LE.500)GO TO 10
2) C WORD COUNT IS IN 11TH WORD
2) C IF(N.LE.350)GO TO 10
2) C CALL TYPWRD(NM)
2) CALL TYPSTR(' FILE TOO BIG ')
2) N=350
2) C GO ON ANYWAY
2) C10 CALL FASTI2(JCLEF(KX*350+1),N)
2) 10 CALL FASTI2(J,N)
2) DO 1 M=2,10
2) IF(KPNT(M).EQ.0)GO TO 2
2) C JUMP OUT IF LESS THAN 10 ITEMS IN FILE
1) CLEFS.F4[NEW,LCS] and 2) UDP:CLEFS.F4[NEW,LCS] 2-18-83 12:09 pages 1,1
2) 1 K(M)=K(M-1)+KPNT(M)-KPNT(M-1)
2) C SET UP POINTER LIST (K)
2) M=11
2) 2 K(M)=K(1)+N
2) C POINTER TO NEXT FREE SPACE
2) L(2)=L(1)+M-1
2) C POINTER TO START OF NEXT FILE'S DATA
2) JPT=JPT+M-1
2) C NEXT LOC. IN KPT ARRAY
2) END
***************